Attribute VB_Name = "modGeneral"
Option Explicit

' API CALLS
Declare Function CoCreateGuid Lib "ole32.dll" (pguid As GUID) As Long
Declare Function StringFromGUID2 Lib "ole32.dll" (rguid As Any, ByVal lpstrClsId As Long, ByVal cbMax As Long) As Long

'GUID STRUCT
Private Type GUID
    Data1 As Long
    Data2 As Long
    Data3 As Long
    Data4(8) As Byte
End Type

'New code added on 29/11/2002 - these are constatns and functions that the IsAppRunning function uses
Public Type TRECT
  lngLeft As Long
  lngTop As Long
  lngRight As Long
  lngBottom As Long
End Type

Public Type TPOINTAPI
  lngX As Long
  lngY As Long
End Type

Public Type TWINDOWPLACEMENT
  lngLength As Long
  lngFlags As Long
  lngShowCmd As Long
  apiptMinPosition As TPOINTAPI
  apiptMaxPosition As TPOINTAPI
  apircNormalPosition As TRECT
End Type

'the is app runnig constants
Public Const VB5_CLASS_NAME = "ThunderRT5Main"

'Funcs for RestorePrevIntsance
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As TWINDOWPLACEMENT) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As TWINDOWPLACEMENT) As Long
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWNORMAL = 1


'\\bxw2105_01

Public objReg As clsRegistry

'ERROR CONSTANTS
'If data is extracted to a file correctly, the no of records extracted is returned
Public Const NO_DATA_TO_EXTRACT As Long = 0
Public Const DATABASE_CONNECTION_FAILED As Long = -1
Public Const ERROR_CREATING_HEADER_RECORD As Long = -2
Public Const ERROR_CREATING_FOOTER_RECORD As Long = -3
Public Const ERROR_READING_RECORDS As Long = -4
Public Const UNKNOWN_ERROR As Long = -5
Public Const NO_VALID_DESTINATION_FOLDER As Long = -6

Public lngErrorCount As Long
Public strErrorString As String
Public strEmailAddress As String


Public Const SQL_DB As String = "SQLOLEDB.1"
Public Const ORA_DB As String = "MSDAORA.1"

'Registry Function Prototypes
Declare Function RegOpenKeyEx Lib "advapi32" _
  Alias "RegOpenKeyExA" ( _
  ByVal hKey As Long, _
  ByVal lpSubKey As String, _
  ByVal ulOptions As Long, _
  ByVal samDesired As Long, _
  phkResult As Long _
) As Long

Declare Function RegQueryValueEx Lib "advapi32" _
  Alias "RegQueryValueExA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String, _
  ByVal lpReserved As Long, _
  ByRef lpType As Long, _
  ByVal szData As String, _
  ByRef lpcbData As Long _
) As Long

Declare Function RegCloseKey Lib "advapi32" ( _
  ByVal hKey As Long _
) As Long

Type TSECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Boolean
End Type


Declare Function RegCreateKeyEx Lib "advapi32" _
  Alias "RegCreateKeyExA" ( _
  ByVal hKey As Long, _
  ByVal lpSubKey As String, _
  ByVal Reserved As Long, _
  ByVal lpClass As String, _
  ByVal dwOptions As Long, _
  ByVal samDesired As Long, _
  lpSecurityAttributes As TSECURITY_ATTRIBUTES, _
  phkResult As Long, _
  lpdwDisposition As Long _
) As Long



Declare Function RegSetValueEx Lib "advapi32" _
  Alias "RegSetValueExA" ( _
  ByVal hKey As Long, _
  ByVal lpValueName As String, _
  ByVal Reserved As Long, _
  ByVal dwType As Long, _
  ByVal szData As String, _
  ByVal cbData As Long _
) As Long

Public Enum AutoErrors
    TEXT_PATH_NULL = vbObjectError + 524
    NO_SOURCE_TYPE = vbObjectError + 525
    MISSING_IMAGE_FILE = vbObjectError + 526
    FILENET_LOGON_FAILED = vbObjectError + 527
    FILENET_COMMIT_FAILED = vbObjectError + 528
    XML_READ_FAILED = vbObjectError + 529
    SOURCE_AUDIT_FAILED = vbObjectError + 530
    CREATE_WORK_OBJECT_FAILED = vbObjectError + 531
End Enum

Private mvar_DBConn As ADODB.Connection
Public sBusinessUnitName As String
Public sBusinessUnit As String
Public oXMLDocument As New DOMDocument
Public OracleConnectionString As String
Public SQLConnectionString As String

Public Const MAX_PATH As Long = &H104

Declare Function GetTempPath Lib "KERNEL32" _
  Alias "GetTempPathA" ( _
  ByVal nBufferLength As Long, _
  ByVal lpBuffer As String _
) As Long

Public objImageLibrary  As Object
'Public objImageLibrary  As New MSSImageLink.clsMSSImageLink
Public strUserId As String
Public strPassword As String
Public sImageStoreCD As String
Public sDefaultImageStoreCd As String


Public Sub TokenizeString(strSearch As String, strSeparator As String, daResult() As Variant)
    Dim Pos As Integer
    Dim strNew As String
    Dim iArrayCounter As Integer

    iArrayCounter = 0
    strNew = strSearch
    Pos = InStr(1, strSearch, strSeparator)
    Do While Pos <> 0
        ReDim Preserve daResult(iArrayCounter)
        daResult(iArrayCounter) = Left(strNew, Pos - 1)
        strNew = Right(strNew, Len(strNew) - Pos)
        iArrayCounter = iArrayCounter + 1
        Pos = InStr(1, strNew, strSeparator)
    Loop
        ReDim Preserve daResult(iArrayCounter)
        daResult(iArrayCounter) = strNew
    'TokenizeString = daResult
End Sub

Public Function Encrypt(ByVal strText As String, _
                        ByVal strCipher As String) As String
  Dim lngIndex As Long
  Dim strEncryptedText As String
  Dim lngCipherLength As Long
  Dim strTextArray() As String
  Dim lngHolder As Long
  Dim strTextHolder As String
  Dim strTextToLongHolder As String
  Dim i As Long


  'check to see if the text sent in is a bunch of numbers
  lngHolder = Val(strText)
  If lngHolder = 0 Then 'this is a string that does not need conversion from the character codes back to a string
    strTextHolder = strText
  Else 'this is a long that needs to be converted back to a string
    ReDim strTextArray(0)

    strTextArray = Split(strText, "~", -1)
    For i = 0 To UBound(strTextArray) - 1
        strTextHolder = strTextHolder & Chr(strTextArray(i))
    Next
  End If
  'both the return and the Text to encrypt need to be longs so
    'that they are not truncated when
  'they get saved or displayed

  'convert the Text to a long

  lngCipherLength = Len(strCipher)

  Do Until Len(strEncryptedText) = Len(strTextHolder)
    For lngIndex = 1 To lngCipherLength

      ' We are done when the two strings are equal in length
      If Len(strEncryptedText) = Len(strTextHolder) Then
        Exit For
      End If

      ' Perform the XOR encryption
      strEncryptedText = strEncryptedText & _
        Chr(Asc(Mid(strTextHolder, Len(strEncryptedText) + 1, 1)) Xor _
        Asc(Mid(strCipher, lngIndex, 1)))
    Next lngIndex
  Loop

  'check the the return value if its a decrypted string COOL

  If lngHolder <> 0 Then ' this is a decrypted string
    ' Return the encrypted/decrypted text
    Encrypt = strEncryptedText
  Else 'this is an encrypted string and needs to be converted to longs
    For i = 1 To Len(strEncryptedText)
        strTextToLongHolder = strTextToLongHolder & Asc(Mid$(strEncryptedText, i, 1)) & "~"
    Next
    'return the long'ed encrypted string
    Encrypt = strTextToLongHolder
  End If

End Function

Sub Main()
    Dim objFormC As Object
    Set objFormC = New clsDirSendFormC
    objFormC.SendFormC
    Set objFormC = Nothing
    End
End Sub

Public Function HandleError(ByRef eError As ErrObject, _
                            ByVal sErrSource As String, _
                            Optional ByVal bTopLevelFunction As Boolean = False)
                            
    'add this error to the error tree.
    Call ModError.AppendToErrorTree(eError.Description, eError.Number, sErrSource)
    
    If bTopLevelFunction = True Then
        Call ModError.ProcessError
        Set ModError.ErrorTree = Nothing
    End If
End Function


Public Function GetSourceMasterTable(ByVal sSourceType As String) As String

    On Error GoTo PROC_ERROR
    'this function will get the environment for the passed in source type.
    Dim strSQL As String
    Dim sEnv As String
    Dim rsEnv As ADODB.Recordset
    Dim rsHolder As ADODB.Recordset
    Dim strSYS As String
    Dim strMasterTable As String
    
    If modGeneral.DBConnection Is Nothing Then
        Call modGeneral.DBConnect("", OracleConnectionString)
    End If
    
    'get the system
    'strSQL = "select SYS_CD from MSS_RULE where SOURCE_ID=" & sSourceType
    strSQL = "select SOURCE_SYS_CD from MSS_SOURCE_CODE where SOURCE_ID=" & sSourceType
    Set rsHolder = modGeneral.DBConnection.Execute(strSQL)
    If rsHolder.BOF = True And rsHolder.EOF = True Then
       'Err.Raise Err.Number, "AutoLogger.modGeneral.GetSourceEnvironment", "Source Code: " & sSourceType & " does not exist in the MSS_RULE Table"
       Err.Raise Err.Number, "AutoLogger.modGeneral.GetSourceEnvironment", "Source Code: " & sSourceType & " does not exist in the MSS_SOURCE_CODE Table"
    End If
    strSYS = rsHolder!SOURCE_SYS_CD
    
    'get the master table
    strSQL = "select MSS_ENVIRONMENT.PARENT_TABLE from MSS_SYSTEM, MSS_ENVIRONMENT where MSS_SYSTEM.SYS_CD='" & strSYS & "' AND MSS_ENVIRONMENT.ENVIRONMENT_ID = MSS_SYSTEM.ENVIRONMENT_ID"
    Set rsHolder = modGeneral.DBConnection.Execute(strSQL)
    strMasterTable = rsHolder!PARENT_TABLE
    
    'pass out the master table
    GetSourceMasterTable = strMasterTable
    
    Exit Function
PROC_ERROR:
    GetSourceMasterTable = Error & "[" & Err & "]"
    'HandleError Err, "AutoLogger.modGeneral.GetSourceEnvironment"
End Function

Public Property Get DBConnection() As ADODB.Connection
    Set DBConnection = mvar_DBConn
End Property

Public Property Set DBConnection(ByRef Conn As ADODB.Connection)
    Set mvar_DBConn = Conn
End Property

Public Function DBDisConnect() As Boolean
    'this function will terminate the connection to the database
    
    On Error GoTo PROC_ERROR
    DBDisConnect = False
    
    'all done so commit the transaction
    If Not (modGeneral.DBConnection Is Nothing) Then
        modGeneral.DBConnection.CommitTrans
    End If
    
    'close the connection
    modGeneral.DBConnection.Close
    Set modGeneral.DBConnection = Nothing
    
    DBDisConnect = True
    Exit Function
PROC_ERROR:
    DBDisConnect = False
    'HandleError Err, "AutoLogger.modGeneral.DBDisConnect"
End Function

Public Function DBConnect(Database As String, Optional ConnectionString As String = "") As Boolean
    'this function will establish a connection to the database
    Dim strConnect As String
    Dim objConn As Object
    Dim sDBID As String
    Dim Get_DatabaseName As Object
    Dim aTest As String
    Dim objMSSConnect As Object
    
    On Error GoTo PROC_ERROR
    
    'init the return to false so if anything fails we will know
    DBConnect = False
    If Len(Database) = 0 Or Database = "" Then
        Set objMSSConnect = CreateObject("MSSConnect.clsSchemaConnect")
        strConnect = objMSSConnect.ConnectString(sBusinessUnit)
        
        Set objMSSConnect = Nothing
    
    Else
        If Len(Trim(ConnectionString)) = 0 Then
            Set objConn = CreateObject("MKConnect.clsConnect")
            
            'get the connect string
            Select Case Database
                Case "Liberty"
                    strConnect = objConn.ConnectString("Liberty")
                Case "KeyTax"
                    strConnect = objConn.ConnectString("KeyTax")
            End Select
        Else
            strConnect = ConnectionString
        End If
        
    End If
    
    'use the conn string and open the connection
    Set modGeneral.DBConnection = New ADODB.Connection
    modGeneral.DBConnection.ConnectionString = strConnect
    modGeneral.DBConnection.Open


    'begin the transaction
    modGeneral.DBConnection.BeginTrans
    
    DBConnect = True
    
    Exit Function
PROC_ERROR:
    DBConnect = False
    'HandleError Err, "AutoLogger.modGeneral.DBConnect"
    Exit Function
    Resume Next
End Function

Public Function GetWorkSourceDetails(Req_Seq_num As String, sMachinename As String) As String
    On Error GoTo PROC_ERROR
    
    Dim sLineNumber As String
    Dim strSQL As String
    Dim rsSource As ADODB.Recordset
    Dim arrSourceID() As String
    Dim arrKT() As String
    Dim rsRQST_RSN As ADODB.Recordset
    Dim rsValid As ADODB.Recordset
    Dim sRQST_RSN As String
    
    Const KEYTAX_REQ_NO As Integer = 0
    Const KEYTAX_EMAIL As Integer = 1
          
    'handle keytax auto directives
    arrKT = Split(Req_Seq_num & "@KEYTAX.CO.ZA", "@")
    If UBound(arrKT) > 0 Then
        If UCase(arrKT(KEYTAX_EMAIL)) = "KEYTAX.CO.ZA" Then
            'perform the Keytax lookup for the directive request reason
            'LCBHolder.sKeyTaxRqstNo = arrKT(KEYTAX_REQ_NO)
                                
            On Error Resume Next
            'Close the previous DB connection and open connection to MS SQL Server
            modGeneral.DBConnection.CommitTrans
            modGeneral.DBConnection.Close
            On Error GoTo PROC_ERROR
            
            'connect to the keytax database
            If Not modGeneral.DBConnect("KeyTax", SQLConnectionString) Then
                Err.Raise vbObjectError, "modGeneral.GetWorkSourceDetails", "Unable to connect to the database"
            End If
            
            'make sure the request really is an interface request by looking for the req_seq_num in the
            'dir interface index table
            Set rsValid = modGeneral.DBConnection.Execute("select count(*) from DIR_INTERFACE_INDEX where REQ_SEQ_NUM = " & arrKT(KEYTAX_REQ_NO))
            If rsValid.Fields(0).Value = 0 Then

            
                'handle the bad file and send notification to the relevant people.
                Err.Raise vbObjectError, "modGeneral.GetWorkSourceDetails.", "This is not a valid KetTax interface request. Cannot index file."
            End If
                    
            Set rsRQST_RSN = modGeneral.DBConnection.Execute("select SCOD_DIR_REQ_RSN from DIR_REQUEST where REQ_SEQ_NUM=" & arrKT(KEYTAX_REQ_NO))
                    
            If rsRQST_RSN.BOF <> True And rsRQST_RSN.EOF <> True Then
                'this is a auto valid request
                rsRQST_RSN.MoveFirst
                'LCBHolder.sDirectiveRqstRsn = rsRQST_RSN!SCOD_DIR_REQ_RSN
                sRQST_RSN = rsRQST_RSN!scod_dir_req_rsn
            End If
            
            Set rsRQST_RSN = Nothing
            
            'Disconnect from Keytax DB
            modGeneral.DBDisConnect
        End If
    End If
    
    On Error Resume Next
    'Close previous MS SQL server db connection and connect to oracle
    modGeneral.DBConnection.CommitTrans
    modGeneral.DBConnection.Close
    On Error GoTo PROC_ERROR
    
    Call modGeneral.DBConnect("")
    
    strSQL = "SELECT SOURCE_ID, FILENET_YN"
    strSQL = strSQL & " from MSS_AUTOLOG_RULE"
    strSQL = strSQL & " where MACHINE_ID = '" & sMachinename & "'"
    strSQL = strSQL & " and SOURCE_TYPE = 'EMAIL'"
    If Len(sRQST_RSN) > 0 Then
        strSQL = strSQL & " and SENT_TO = '" & sRQST_RSN & "'"
    Else
        'the line the fax came in on...
        strSQL = strSQL & " and SENT_TO IS NULL"
    End If

    Set rsSource = modGeneral.DBConnection.Execute(strSQL)
    If rsSource.BOF = True And rsSource.EOF = True Then
        'there was no source type
        'bFailed = True
        GetWorkSourceDetails = ""
        Exit Function
    End If
            
    rsSource.MoveFirst
    'sUseFileNetYN = rsSource!FILENET_YN
    GetWorkSourceDetails = rsSource!SOURCE_ID
       ' End If
    Exit Function
PROC_ERROR:
    'HandleError Err, "AutoLogger.modGeneral.GetWorkSourceDetails"
End Function

Public Function SaveToSourceAudit(ByRef lSourceAuditId As Long, _
                                  ByRef strErrMsg As String, _
                                  ByRef strFileName As String, _
                                  ByRef sBusinessUnit As String, _
                                  ByRef lngPageCount As Long, _
                                  ByRef sStationName) As Boolean
    
    Dim strLastFilename As String
    Dim strControlFile As String
    Dim blnSelected As Boolean
    Dim objSourceAudit As Object
    
    On Error GoTo SaveToSourceAuditFix

    'strControlFile = Globals.objScanStation.GetLastProcessPathFileName
    
    'strFileName must be a GUID
    strControlFile = UCase(strFileName)  ' Globals.objScanStation.GetNextProcessPathFileName
resumeproc:
    'create instance of dll
    Set objSourceAudit = Nothing
    Set objSourceAudit = CreateObject("SourceAudit.clsAudit")
    
    'call dll_
    'Richard: Business Unit Required here - use generic schema - list if required.
    SaveToSourceAudit = objSourceAudit.Audit(lSourceAuditId, sBusinessUnit, "EMAIL", "KEYTAX", UCase(strControlFile), _
        lngPageCount, Format$(Now, "dd-MMM-yyyy hh:nn:ss"), sStationName, "")
        
    'terminate instance of dll
    Set objSourceAudit = Nothing
    
    Exit Function
    
SaveToSourceAuditFix:
    GoTo resumeproc:
    strErrMsg = Err.Description
    SaveToSourceAudit = False
End Function

'*---------------------------------------------------------------
'* Procedure:    GetTemporaryFilename
'* Description:  The GetTempFileName function creates a name for
'*               a temporary file
'* Parameters:   Optional strTempFilePrefix
'*               - A THREE letter prefix for the temporary file
'*                 name. This defaults to TMP if not specified.
'*               Optional strTempDir
'*               - The directory path for the filename. If this
'*                 is not specified then it defaults to the
'*                 system temporary directory.
'* Returns:      String - A unique temporary file name.
'* Comments:     The GetTempFileName function creates a temporary
'*               filename of the following form:
'*                   path\preuuuu.tmp, where
'*               - path: Path specified by strTempDir
'*               - pre:  First three letters of strTempFilePrefix
'*               - uuuu: Unqieu Hexadecimal value
'*               The file is not created, and temporary files
'*               are not automatically deleted.
'*---------------------------------------------------------------
Public Function GetTemporaryFilename(Optional ByVal strTempDir As String, _
                                     Optional ByVal strTempFilePrefix As String = "TMP", _
                                     Optional ByVal strTempFileSuffix As String = "TMP") As String
  Dim lngRetVal As Long
  Dim strTempPath As String
  'Dim strTempPrefix As String * 3
  Dim strTempPrefix As String
  Dim strTempFileName As String
  Dim strTemp As String
  Dim lngFileNumber As Long
  
  On Error GoTo errhandler:
  ' Use the specified file-prefix if we were passed one
  'If strTempFilePrefix <> "" Then
  '  strTempPrefix = Left$(strTempFilePrefix, 2)
  'End If
  strTempPrefix = strTempFilePrefix
  
  ' Get the default temp directory if we were not passed one
  If strTempDir = "" Then
    strTempPath = GetTemporaryPath
  Else
    strTempPath = strTempDir
  End If
  
  ' Generate a unique file name using a file number from the registry
  Do
    ' Get the last used file number
    ' Increment it by one and save it back to the registry

    'Tina
    'lngFileNumber = Globals.objScanSettings.TextFileNumber
    Set objReg = New clsRegistry
    lngFileNumber = objReg.TextFileNumber
    
    lngFileNumber = lngFileNumber + 1

    
    If lngFileNumber > 999999 Then
      lngFileNumber = 0
    End If
    'Tina
    'Globals.objScanSettings.TextFileNumber = lngFileNumber
    objReg.TextFileNumber = lngFileNumber

  
    strTempFileName = AddTrailingBackslash(strTempPath) & _
                      strTempFilePrefix & _
                      Format$(lngFileNumber, "000000") & _
                      "." & strTempFileSuffix
  Loop While Dir$(strTempFileName, vbNormal) <> ""
  
  GetTemporaryFilename = strTempFileName
  Exit Function
errhandler:
  Exit Function
  Resume Next
End Function

'*---------------------------------------------------------------
'* Procedure:    GetTemporaryPath
'* Description:  The GetTempPath function retrieves the path of
'*               the directory designated for temporary files
'* Parameters:   None
'* Returns:      String - The string containing the path
'* Comments:     The GetTempPath function gets the temporary file
'*               path as follows:
'*               1.  The path specified by the TMP environment
'*                   variable.
'*               2.  The path specified by the TEMP environment
'*                   variable, if TMP is not defined.
'*               3.  The current directory, if both TMP and TEMP
'*                   are not defined.
'*---------------------------------------------------------------
Public Function GetTemporaryPath() As String
  Dim strTempPath As String * MAX_PATH
  Dim lngPathLength As Long
  
  ' Read the enviroment variable
  lngPathLength = GetTempPath(MAX_PATH, strTempPath)
  
  If lngPathLength = 0 Then
    ' Return the current working directory if GetTempPath failed
    GetTemporaryPath = CurDir
  Else
    ' Get the Windows temporary path from the ASCIIZ string
    GetTemporaryPath = Left(strTempPath, InStr(strTempPath, Chr(0)) - 1)
  End If
End Function ' GetTempPath


'*---------------------------------------------------------------
'* Method:       AddTrailingBackslash
'* Description:  Make sure the specified path-name ends in
'*               a backslash so we can add a filename to it
'*               without error.
'* Parameters:   strPath - The pathname to add the backslash to
'* Returns:      String - The string ending in a backslash
'* Comments:     A backslash is only added if necessary
'*---------------------------------------------------------------
Public Function AddTrailingBackslash(ByVal strPath As String) As String
  Dim strNewPath As String
  
  strNewPath = strPath
  
  If Right$(strPath, 1) <> "\" Then
    strNewPath = strNewPath & "\"
  End If
  
  AddTrailingBackslash = strNewPath
End Function

Public Sub GetKeytaxIndexInfo(ByVal sKeytaxRqstNum As String, _
                                   ByRef sMemberNo As String)

    On Error GoTo PROC_ERROR
    Dim rsIndex As ADODB.Recordset
    Dim strSQL As String
    Dim sTempConString
    
    'if we are already connected store the conn string and disconect
    If Not (modGeneral.DBConnection Is Nothing) Then
        sTempConString = modGeneral.DBConnection.ConnectionString
        modGeneral.DBDisConnect
    End If
    
    'connect to keytax
    Call modGeneral.DBConnect("KeyTax", SQLConnectionString)
        
    'get the member number
    strSQL = "select fund_membership_number from dir_request where req_seq_num = " & sKeytaxRqstNum
    Set rsIndex = modGeneral.DBConnection.Execute(strSQL)
    sMemberNo = rsIndex!fund_membership_number
    
    modGeneral.DBDisConnect
    If Len(sTempConString) > 0 Then
        'reconnect to the original database
        Set modGeneral.DBConnection = New ADODB.Connection
        modGeneral.DBConnection.ConnectionString = sTempConString
        modGeneral.DBConnection.Open
    End If
    
    'sMemberNo = modGeneral.LCBHolder.sMemberNo
    Exit Sub
PROC_ERROR:
    Exit Sub
    'HandleError Err, "AutoLogger.modGeneral.GetKeytaxIndexInfo"
End Sub

Public Sub GetSchemeAndMemberInfo(ByRef sSchemeNo As String, _
                                  ByVal sMemberNo As String, _
                                  ByRef sSchemeName As String, _
                                  ByRef sMemberSurname As String, _
                                  ByRef sMemberInitals As String, _
                                  ByRef sMemberIDNum As String)

    On Error GoTo PROC_ERROR
    Dim rsHolder As ADODB.Recordset
    Dim strSQL As String

resumeproc:
    On Error Resume Next
    'Close previous MS SQL server db connection and connect to oracle
    modGeneral.DBConnection.CommitTrans
    modGeneral.DBConnection.Close
    On Error GoTo PROC_ERROR
    
    Call modGeneral.DBConnect("")

    
    strSQL = "select SURNAME, INITIALS, ID_NUMBER, SCHEME_NAME, SCHEME_NO from LCBWF_SCHEME_MEMBER_VW where MEMBER_NO = '" & sMemberNo & "'"
    Set rsHolder = modGeneral.DBConnection.Execute(strSQL)
    
    If rsHolder.BOF <> True And rsHolder.EOF <> True Then
        rsHolder.MoveFirst
        sMemberSurname = rsHolder!SURNAME
        sMemberInitals = rsHolder!INITIALS
        If Not IsNull(rsHolder!ID_NUMBER) Then
            sMemberIDNum = rsHolder!ID_NUMBER
            sMemberIDNum = " "
        End If
        sSchemeName = rsHolder!SCHEME_NAME
        If Not IsNull(rsHolder!SCHEME_NO) Then
            sSchemeNo = rsHolder!SCHEME_NO
        Else
            sSchemeNo = " "
        End If
    End If
    
    Set rsHolder = Nothing
    
    Exit Sub
PROC_ERROR:
    GoTo resumeproc:
    'GetSchemeAndMemberInfo = Error & "[" & Err.Number & "]"
    Exit Sub
    Resume Next
    'HandleError Err, "AutoLogger.modGeneral.GetSchemeAndMemberInfo"
End Sub

Public Function SendEmail(ByVal sToAddress As String, _
                          ByVal sFromAddress As String, _
                          ByVal sSubject As String, _
                          ByVal sBody As String, _
                          ByVal sFromName As String) As Boolean

   On Error GoTo Eh
    
   Dim arMailTo As Variant
   Dim oMail As Object
   Dim i As Integer
   Dim sAttachmentName As String
   Dim EnableQueue As Boolean
                        
   On Error GoTo Eh
    
   Set oMail = CreateObject("jmail.Message")
   
   'arMailTo = Split(sToAddress, ";")
   arMailTo = Split(objReg.QA_Team, ";")
   
   With oMail
        'Get all people who normally QA email for assurance.
        Dim arQA_Team() As String
        Dim k As Long
        
        'Just in case no one is setup then
        If Len(objReg.QA_Team) > 0 Then
            arQA_Team = Split(objReg.QA_Team, ";")
            For k = LBound(arQA_Team) To UBound(arQA_Team)
                .AddRecipient arQA_Team(k), ""
            Next k
        Else
            .AddRecipient "info@mindkey.co.za", "Keytax Helpdesk"
        End If
        
        'For i = 0 To UBound(arMailTo)
        '    .AddRecipient CStr(Trim(arMailTo(i)))
        'Next
        
        If sFromName = "" Then
             sFromName = "Keytax Interface"
        End If
                               
        .ISOEncodeHeaders = False
        .From = sFromAddress
        .Subject = sSubject
        .FromName = sFromName
        .Body = sBody
        .send "trend1.liberty.co.za", False
        
    End With
Exit_Function:
   ' Call oEmail.CleanInfo
    Set oMail = Nothing
   ' Set oEmail = Nothing
    Exit Function

Eh:
    'Err.Raise Err.Number, Err.Source, Err.Description
    GoTo Exit_Function
    Resume
End Function
 
Public Function GetFilenameWithoutExtention(sFileName As String) As String
    Dim intPos As Long
    Dim FilenameWithoutExt As String
    
    On Error GoTo errhandler:
    
    If InStr(1, sFileName, ".") <> 0 Then
        intPos = InStrRev(sFileName, ".") - 1
        FilenameWithoutExt = Mid(sFileName, 1, intPos)
    Else
        FilenameWithoutExt = sFileName
    End If
    GetFilenameWithoutExtention = FilenameWithoutExt
    Exit Function
errhandler:
    GetFilenameWithoutExtention = ""
    Exit Function
    Resume Next
End Function
 
Public Function GetGuid() As String
    ' #VBIDEUtils#************************************************************
    ' * Programmer Name  : Kuba Gluszkiewicz
    ' * Web Site         : www.citysoftware.com.pl
    ' * E-Mail           : k.gluszkiewicz@citysoftware.com.pl
    ' * Date             : 04-21-2002
    ' * Time             : 23:47
    ' * Module Name      : modGuid
    ' * Module Filename  :
    ' * Procedure Name   : GetGuid
    ' * Parameters       :
    ' **********************************************************************
    ' * Comments         :
    ' *
    ' *
    ' **********************************************************************
    
    Dim udtGuid As GUID
    Dim sGuid As String
    Dim bytGuid() As Byte
    Dim lRet As Long
    Dim lLen As Long

    On Error GoTo errhandler:
    
    lLen = 40
    bytGuid = String(lLen, 0)
    CoCreateGuid udtGuid
    lRet = StringFromGUID2(udtGuid, VarPtr(bytGuid(0)), lLen)
    ' VarPtr is hidden VB function
    ' we need this function to format string (Basic String)
    sGuid = bytGuid
    If (Asc(Mid$(sGuid, lRet, 1)) = 0) Then
        lRet = lRet - 1
    End If
    GetGuid = Left$(sGuid, lRet)
    Exit Function
errhandler:
    Exit Function
    Resume Next
End Function
 

Public Function ImageLibraryLogon() As Boolean

    'Dim strUserId As String
    'Dim strPassword As String
    Dim i As Long
    
    On Error GoTo errhandler:
    Screen.MousePointer = vbHourglass
    
    'strUserId = strUserId 'objReg.LastUser
    'strPassword = objReg.Password
    
    If StartImageLibraryConnection(strUserId, strPassword) Then
        ImageLibraryLogon = True
    Else
        ImageLibraryLogon = False
    End If
    Exit Function
errhandler:
    ImageLibraryLogon = False
    Exit Function
    Resume Next
End Function

'This part of SBI implementation(Please speak to BM or RL if you experience any problems connecting to SBI)
Private Function StartImageLibraryConnection(strLogonName As String, strPassword As String) As Boolean

    Dim lngErr As Long
    
    Screen.MousePointer = vbHourglass

    On Error GoTo StartImageLibraryConnectionFix:
    
    strLogonName = strLogonName
    strPassword = strPassword
    
    lngErr = objImageLibrary.MSS_Logon(strLogonName, strPassword, sBusinessUnit)
    'lngErr = objImageLibrary.MSS_Logon(strLogonName, strPassword)
    
    If lngErr = 0 Or lngErr = 704643121 Then
        '704643121 - User already connected
        StartImageLibraryConnection = True
    Else
        Screen.MousePointer = vbDefault
        MsgBox objImageLibrary.MSS_ErrorMessage(lngErr), vbOKOnly + vbExclamation
        StartImageLibraryConnection = False
    End If
    
    Screen.MousePointer = vbHourglass

    Exit Function
    
StartImageLibraryConnectionFix:
    'HandleError Err.Number & " - " & Err.Description, "StartImageLibraryConnection"
    Screen.MousePointer = vbHourglass
    StartImageLibraryConnection = False
    Exit Function
    Resume Next
End Function



